home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / remind1a / frmabout.frm (.txt) < prev    next >
Visual Basic Form  |  1999-10-05  |  10KB  |  257 lines
  1. VERSION 5.00
  2. Begin VB.Form frmAbout 
  3.    BorderStyle     =   3  'Fester Dialog
  4.    Caption         =   "About Remind Me"
  5.    ClientHeight    =   3555
  6.    ClientLeft      =   2340
  7.    ClientTop       =   1935
  8.    ClientWidth     =   5730
  9.    ClipControls    =   0   'False
  10.    LinkTopic       =   "Form2"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   2453.724
  14.    ScaleMode       =   0  'Benutzerdefiniert
  15.    ScaleWidth      =   5380.766
  16.    ShowInTaskbar   =   0   'False
  17.    Begin VB.PictureBox picIcon 
  18.       AutoSize        =   -1  'True
  19.       ClipControls    =   0   'False
  20.       Height          =   540
  21.       Left            =   240
  22.       Picture         =   "frmAbout.frx":0000
  23.       ScaleHeight     =   337.12
  24.       ScaleMode       =   0  'Benutzerdefiniert
  25.       ScaleWidth      =   337.12
  26.       TabIndex        =   1
  27.       Top             =   240
  28.       Width           =   540
  29.    End
  30.    Begin VB.CommandButton cmdOK 
  31.       Cancel          =   -1  'True
  32.       Caption         =   "OK"
  33.       Default         =   -1  'True
  34.       Height          =   345
  35.       Left            =   4245
  36.       TabIndex        =   0
  37.       Top             =   2625
  38.       Width           =   1260
  39.    End
  40.    Begin VB.CommandButton cmdSysInfo 
  41.       Caption         =   "&Systeminfo..."
  42.       Height          =   345
  43.       Left            =   4260
  44.       TabIndex        =   2
  45.       Top             =   3075
  46.       Width           =   1245
  47.    End
  48.    Begin VB.Label Label2 
  49.       Caption         =   "itsme123@mail.com"
  50.       ForeColor       =   &H00FF0000&
  51.       Height          =   375
  52.       Left            =   3480
  53.       TabIndex        =   7
  54.       Top             =   2040
  55.       Width           =   1575
  56.    End
  57.    Begin VB.Label Label1 
  58.       Caption         =   "If you have any question,please send me an email at:"
  59.       Height          =   255
  60.       Left            =   1080
  61.       TabIndex        =   6
  62.       Top             =   1680
  63.       Width           =   3975
  64.    End
  65.    Begin VB.Line Line1 
  66.       BorderColor     =   &H00808080&
  67.       BorderStyle     =   6  'Innen ausgef
  68.       Index           =   1
  69.       X1              =   84.515
  70.       X2              =   5309.398
  71.       Y1              =   1687.583
  72.       Y2              =   1687.583
  73.    End
  74.    Begin VB.Label lblDescription 
  75.       Caption         =   "Created by Michael Hauck"
  76.       ForeColor       =   &H00000000&
  77.       Height          =   330
  78.       Left            =   1050
  79.       TabIndex        =   3
  80.       Top             =   1125
  81.       Width           =   3885
  82.    End
  83.    Begin VB.Label lblTitle 
  84.       Caption         =   "Remind Me 1.0"
  85.       ForeColor       =   &H00000000&
  86.       Height          =   480
  87.       Left            =   1050
  88.       TabIndex        =   4
  89.       Top             =   240
  90.       Width           =   3885
  91.    End
  92.    Begin VB.Line Line1 
  93.       BorderColor     =   &H00FFFFFF&
  94.       BorderWidth     =   2
  95.       Index           =   0
  96.       X1              =   98.6
  97.       X2              =   5309.398
  98.       Y1              =   1697.936
  99.       Y2              =   1697.936
  100.    End
  101.    Begin VB.Label lblVersion 
  102.       Caption         =   "Version"
  103.       Height          =   225
  104.       Left            =   1050
  105.       TabIndex        =   5
  106.       Top             =   780
  107.       Width           =   3885
  108.    End
  109. Attribute VB_Name = "frmAbout"
  110. Attribute VB_GlobalNameSpace = False
  111. Attribute VB_Creatable = False
  112. Attribute VB_PredeclaredId = True
  113. Attribute VB_Exposed = False
  114. Option Explicit
  115. ' Registrierungsschl
  116. ssel-Sicherheitsoptionen...
  117. Const READ_CONTROL = &H20000
  118. Const KEY_QUERY_VALUE = &H1
  119. Const KEY_SET_VALUE = &H2
  120. Const KEY_CREATE_SUB_KEY = &H4
  121. Const KEY_ENUMERATE_SUB_KEYS = &H8
  122. Const KEY_NOTIFY = &H10
  123. Const KEY_CREATE_LINK = &H20
  124. Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
  125.                        KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
  126.                        KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
  127.                      
  128. ' Registrierungsschl
  129. ssel-Stammtypen...
  130. Const HKEY_LOCAL_MACHINE = &H80000002
  131. Const ERROR_SUCCESS = 0
  132. Const REG_SZ = 1                         ' Null-terminierte Unicode-Zeichenfolge
  133. Const REG_DWORD = 4                      ' 32-Bit-Zahl
  134. Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
  135. Const gREGVALSYSINFOLOC = "MSINFO"
  136. Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
  137. Const gREGVALSYSINFO = "PATH"
  138. Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
  139. Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
  140. Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
  141. Private Sub cmdSysInfo_Click()
  142.   Call StartSysInfo
  143. End Sub
  144. Private Sub cmdOK_Click()
  145.   Unload Me
  146. End Sub
  147. Private Sub Form_Load()
  148.     Me.Caption = "Info zu " & App.Title
  149.     lblVersion.Caption = "Version " & App.Major & "." & App.Minor & "." & App.Revision
  150.     lblTitle.Caption = App.Title
  151. End Sub
  152. Public Sub StartSysInfo()
  153.     On Error GoTo SysInfoErr
  154.     Dim rc As Long
  155.     Dim SysInfoPath As String
  156.     ' Versuchen, den Systeminfo-Programmpfad/-namen aus der Registrierung abzurufen...
  157.     If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
  158.     ' Versuchen, nur den Systeminfo-Programmpfad aus der Registrierung abzurufen...
  159.     ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
  160.         ' 
  161. berpr
  162. fen, ob bekannte 32-Dateiversion vorhanden ist
  163.         If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
  164.             SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
  165.             
  166.         ' Fehler - Datei wurde nicht gefunden...
  167.         Else
  168.             GoTo SysInfoErr
  169.         End If
  170.     ' Fehler - Registrierungseintrag wurde nicht gefunden...
  171.     Else
  172.         GoTo SysInfoErr
  173.     End If
  174.     Call Shell(SysInfoPath, vbNormalFocus)
  175.     Exit Sub
  176. SysInfoErr:
  177.     MsgBox "Systeminformationen sind momentan nicht verf
  178. gbar", vbOKOnly
  179. End Sub
  180. Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
  181.     Dim i As Long                                           ' Schleifenz
  182.     Dim rc As Long                                          ' R
  183. ckgabe-Code
  184.     Dim hKey As Long                                        ' Zugriffsnummer f
  185. r einen offenen Registrierungsschl
  186.     Dim hDepth As Long                                      '
  187.     Dim KeyValType As Long                                  ' Datentyp eines Registrierungsschl
  188. ssels
  189.     Dim tmpVal As String                                    ' Tempor
  190. rer Speicher eines Registrierungsschl
  191. sselwertes
  192.     Dim KeyValSize As Long                                  ' Gr
  193. e der Registrierungsschl
  194. sselvariablen
  195.     '------------------------------------------------------------
  196.     ' Registrierungsschl
  197. ssel unter KeyRoot {HKEY_LOCAL_MACHINE...} 
  198. ffnen
  199.     '------------------------------------------------------------
  200.     rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Registrierungsschl
  201. ssel 
  202. ffnen
  203.     If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Fehler behandeln...
  204.     tmpVal = String$(1024, 0)                             ' Platz f
  205. r Variable reservieren
  206.     KeyValSize = 1024                                       ' Gr
  207. e der Variable markieren
  208.     '------------------------------------------------------------
  209.     ' Registrierungsschl
  210. sselwert abrufen...
  211.     '------------------------------------------------------------
  212.     rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
  213.                          KeyValType, tmpVal, KeyValSize)    ' Schl
  214. sselwert abrufen/erstellen
  215.                         
  216.     If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Fehler behandeln
  217.     If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then           ' Win95 f
  218. gt null-terminierte Zeichenfolge hinzu...
  219.         tmpVal = Left(tmpVal, KeyValSize - 1)               ' Null gefunden, aus Zeichenfolge extrahi